home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / byte0787.arc / IWPAS.ARC / IMAGES.P < prev    next >
Encoding:
Text File  |  1987-04-28  |  10.9 KB  |  383 lines
  1. { IMAGES.P -- image procecssing routines                }
  2. { All images must be decompressed first!                }
  3.  
  4. { Copyright (c) 1987, Ciarcia's Circuit Cellar          }
  5. {    All Rights Reserved                                }
  6.  
  7. {-------------------------------------------------------}
  8. { Do pic1 + pic2 into pic3                              }
  9. { Sticks at maxbit                                      }
  10.  
  11. PROCEDURE Add(pic1,pic2,pic3 : picptr);
  12.  
  13. VAR
  14.  lndx      : linerng;           { line number           }
  15.  pndx      : pelrng;            { pel number            }
  16.  pelval    : INTEGER;           { pel value             }
  17.  
  18. BEGIN
  19.  
  20.  FOR lndx := 0 TO maxline DO
  21.   FOR pndx := 0 TO maxpel DO BEGIN
  22.    pelval := pic1^.fmt.lines[lndx].pels[pndx] +
  23.               pic2^.fmt.lines[lndx].pels[pndx];
  24.    IF pelval > maxbit
  25.     THEN pic3^.fmt.lines[lndx].pels[pndx] := maxbit
  26.     ELSE pic3^.fmt.lines[lndx].pels[pndx] := pelval;
  27.   END;
  28. END;
  29.  
  30.  
  31. {-------------------------------------------------------}
  32. { Do pic1 - pic2 into pic3                              }
  33. { Sticks at zero for pic1 < pic2                        }
  34.  
  35. PROCEDURE Subtract(pic1,pic2,pic3 : picptr);
  36.  
  37. VAR
  38.  lndx      : linerng;           { line number           }
  39.  pndx      : pelrng;            { pel number            }
  40.  
  41. BEGIN
  42.  
  43.  FOR lndx := 0 TO maxline DO
  44.   FOR pndx := 0 TO maxpel DO
  45.    IF pic1^.fmt.lines[lndx].pels[pndx] >=
  46.       pic2^.fmt.lines[lndx].pels[pndx]
  47.     THEN pic3^.fmt.lines[lndx].pels[pndx] :=
  48.                    pic1^.fmt.lines[lndx].pels[pndx] -
  49.                    pic2^.fmt.lines[lndx].pels[pndx]
  50.     ELSE pic3^.fmt.lines[lndx].pels[pndx] := 0;
  51.  
  52. END;
  53.  
  54.  
  55. {-------------------------------------------------------}
  56. { Do pic1 masked by pic2 into pic3                      }
  57. { Only pic1 pels at non-zero pic2 pels go to pic3       }
  58.  
  59. PROCEDURE Mask(pic1,pic2,pic3 : picptr);
  60.  
  61. VAR
  62.  lndx      : linerng;           { line number           }
  63.  pndx      : pelrng;            { pel number            }
  64.  
  65. BEGIN
  66.  
  67.  FOR lndx := 0 TO maxline DO
  68.   FOR pndx := 0 TO maxpel DO
  69.    IF pic2^.fmt.lines[lndx].pels[pndx] <> 0
  70.     THEN pic3^.fmt.lines[lndx].pels[pndx] :=
  71.                    pic1^.fmt.lines[lndx].pels[pndx]
  72.     ELSE pic3^.fmt.lines[lndx].pels[pndx] := 0;
  73.  
  74. END;
  75.  
  76.  
  77. {-------------------------------------------------------}
  78. { Do Abs(pic1 - pic2) into pic3                         }
  79. { Detects changes in images                             }
  80.  
  81. PROCEDURE Compare(pic1,pic2,pic3 : picptr);
  82.  
  83. VAR
  84.  lndx      : linerng;           { line number           }
  85.  pndx      : pelrng;            { pel number            }
  86.  
  87. BEGIN
  88.  
  89.  FOR lndx := 0 TO maxline DO
  90.   FOR pndx := 0 TO maxpel DO
  91.     pic3^.fmt.lines[lndx].pels[pndx] := Abs(
  92.                    pic1^.fmt.lines[lndx].pels[pndx] -
  93.                    pic2^.fmt.lines[lndx].pels[pndx]);
  94.  
  95. END;
  96.  
  97.  
  98. {-------------------------------------------------------}
  99. { Add a constant to pic1                                }
  100.  
  101. PROCEDURE Offset(pic1 : picptr;
  102.                  newoffs : BYTE);
  103.  
  104. VAR
  105.  lndx      : linerng;           { line number           }
  106.  pndx      : pelrng;            { pel number            }
  107.  pelval    : INTEGER;           { pel value             }
  108.  
  109. BEGIN
  110.  
  111.  FOR lndx := 0 TO maxline DO
  112.   FOR pndx := 0 TO maxpel DO BEGIN
  113.    pelval := newoffs + pic1^.fmt.lines[lndx].pels[pndx];
  114.    IF (pelval AND $FFC0) = 0
  115.     THEN pic1^.fmt.lines[lndx].pels[pndx] := pelval
  116.     ELSE pic1^.fmt.lines[lndx].pels[pndx] := maxbit;
  117.  END;
  118.  
  119. END;
  120.  
  121.  
  122. {-------------------------------------------------------}
  123. { Multiply pic1 by a value                              }
  124. { Sticks at maximum value                               }
  125.  
  126. PROCEDURE Multiply(pic1 : picptr;
  127.                    newscale : REAL);
  128.  
  129. VAR
  130.  lndx      : linerng;           { line number           }
  131.  pndx      : pelrng;            { pel number            }
  132.  pelval    : INTEGER;           { pel value             }
  133.  
  134. BEGIN
  135.  
  136.  FOR lndx := 0 TO maxline DO
  137.   FOR pndx := 0 TO maxpel DO BEGIN
  138.    pelval := Trunc(newscale * pic1^.fmt.lines[lndx].pels[pndx]);
  139.    IF (pelval AND $FFC0) = 0
  140.     THEN BEGIN
  141.      pic1^.fmt.lines[lndx].pels[pndx] := pelval;
  142.     END
  143.     ELSE BEGIN
  144.      pic1^.fmt.lines[lndx].pels[pndx] := maxbit;
  145.     END;
  146.   END;
  147.  
  148. END;
  149.  
  150.  
  151. {-------------------------------------------------------}
  152. { Threshold pic1 at a brightness level                  }
  153.  
  154. PROCEDURE Threshold(pic1 : picptr;
  155.                     level : BYTE);
  156.  
  157. VAR
  158.  lndx      : linerng;           { line number           }
  159.  pndx      : pelrng;            { pel number            }
  160.  
  161. BEGIN
  162.  
  163.  FOR lndx := 0 TO maxline DO
  164.   FOR pndx := 0 TO maxpel DO
  165.    IF pic1^.fmt.lines[lndx].pels[pndx]  < level
  166.     THEN pic1^.fmt.lines[lndx].pels[pndx] := 0;
  167.  
  168. END;
  169.  
  170.  
  171. {-------------------------------------------------------}
  172. { Invert pel values                                     }
  173.  
  174. PROCEDURE Invert(pic1 : picptr);
  175.  
  176. VAR
  177.  lndx      : linerng;           { line number           }
  178.  pndx      : pelrng;            { pel number            }
  179.  
  180. BEGIN
  181.  
  182.  FOR lndx := 0 TO maxline DO
  183.   FOR pndx := 0 TO maxpel DO
  184.    pic1^.fmt.lines[lndx].pels[pndx]  := maxbit AND
  185.       (NOT pic1^.fmt.lines[lndx].pels[pndx]);
  186.  
  187. END;
  188.  
  189.  
  190. {-------------------------------------------------------}
  191. { Filter by averaging vertical and horizontal neighbors }
  192.  
  193. PROCEDURE Filter1(pic1,pic2 : picptr);
  194.  
  195. VAR
  196.  lndx      : linerng;           { line number           }
  197.  pndx      : pelrng;            { pel number            }
  198.  
  199. BEGIN
  200.  
  201.  FOR lndx := 1 TO (maxline-1) DO
  202.   FOR pndx := 1 TO (maxpel-1) DO
  203.    pic2^.fmt.lines[lndx].pels[pndx] :=
  204.       (pic1^.fmt.lines[lndx-1].pels[pndx] +
  205.        pic1^.fmt.lines[lndx+1].pels[pndx] +
  206.        pic1^.fmt.lines[lndx].pels[pndx-1] +
  207.        pic1^.fmt.lines[lndx].pels[pndx+1])
  208.       SHR 2;
  209.  
  210. END;
  211.  
  212.  
  213. {-------------------------------------------------------}
  214. { Edge detection                                        }
  215.  
  216. PROCEDURE Edge(pic1,pic2 : picptr);
  217.  
  218. VAR
  219.  lndx      : linerng;           { line number           }
  220.  pndx      : pelrng;            { pel number            }
  221.  
  222. BEGIN
  223.  
  224.  FOR lndx := 1 TO (maxline-1) DO
  225.   FOR pndx := 1 TO (maxpel-1) DO
  226.    pic2^.fmt.lines[lndx].pels[pndx] :=
  227.       (Abs(pic1^.fmt.lines[lndx-1].pels[pndx] -
  228.            pic1^.fmt.lines[lndx+1].pels[pndx]) +
  229.        Abs(pic1^.fmt.lines[lndx].pels[pndx-1] -
  230.            pic1^.fmt.lines[lndx].pels[pndx+1]) +
  231.        Abs(pic1^.fmt.lines[lndx-1].pels[pndx-1] -
  232.            pic1^.fmt.lines[lndx+1].pels[pndx+1]) +
  233.        Abs(pic1^.fmt.lines[lndx+1].pels[pndx-1] -
  234.            pic1^.fmt.lines[lndx-1].pels[pndx+1]))
  235.       SHR 2;
  236.  
  237. END;
  238.  
  239.  
  240. {-------------------------------------------------------}
  241. { Compute intensity histogram for pic1                  }
  242. { Histogram bins are REAL to avoid problems over 32K    }
  243.  
  244. PROCEDURE Histogram(pic1 :picptr;
  245.            VAR histo : histtype);
  246.  
  247. VAR
  248.  hndx      : bitrng;            { histogram bin number  }
  249.  lndx      : linerng;           { line number           }
  250.  pndx      : pelrng;            { pel number            }
  251.  
  252. BEGIN
  253.  
  254.  FOR hndx := 0 TO maxbit DO     { reset histogram       }
  255.   histo[hndx] := 0;
  256.  
  257.  FOR lndx := 0 TO maxline DO
  258.   FOR pndx := 0 TO maxpel DO
  259.    histo[pic1^.fmt.lines[lndx].pels[pndx]] :=
  260.      histo[pic1^.fmt.lines[lndx].pels[pndx]] + 1.0;
  261.  
  262. END;
  263.  
  264.  
  265. {-------------------------------------------------------}
  266. { Display histogram on screen                           }
  267. { Truncates longest bar to give better resolution for   }
  268. {  the rest of the bins                                 }
  269.  
  270. PROCEDURE ShowHist(histogram : histtype);
  271.  
  272. CONST
  273.  barchar   = $DB;               { display char for bar  }
  274.  halfbar   = $DC;               { half length bar       }
  275.  maxbar    = 20;                { length of longest bar }
  276.  
  277. VAR
  278.  binID     : INTEGER;
  279.  maxval    : REAL;              { the largest bin value }
  280.  maxval1   : REAL;              { the next largest bin  }
  281.  barbase   : REAL;              { bottom of bar         }
  282.  barmid    : REAL;              { middle of bar         }
  283.  barstep   : REAL;              { height of steps       }
  284.  halfstep  : REAL;              { half of barstep       }
  285.  barctr    : INTEGER;           { character within bar  }
  286.  
  287. BEGIN
  288.  
  289.  maxval := 1.0;                 { find largest value    }
  290.  maxval1 := maxval;
  291.  binID := 0;
  292.  FOR binID := 0 TO maxbit DO BEGIN
  293.   IF histogram[binID] > maxval
  294.    THEN BEGIN                   { new all-time high?    }
  295.     maxval1 := maxval;          { save previous high    }
  296.     maxval := histogram[binID]; { set new high          }
  297.    END
  298.    ELSE IF histogram[binID] > maxval1  { 2nd highest?   }
  299.          THEN maxval1 := histogram[binID];
  300.  END;
  301.  
  302.  barstep := maxval1 / maxbar;   { steps between lines   }
  303.  halfstep := barstep / 2.0;     { half of one step      }
  304.  
  305.  FOR barctr := maxbar DOWNTO 1 DO BEGIN  { down bars    }
  306.   barbase := Trunc(barstep * barctr);
  307.   barmid  := barbase + halfstep;
  308.   Write(barbase:6:0);
  309.   FOR binID := 0 TO maxbit DO            { for each bin }
  310.    IF histogram[binID] > barmid
  311.     THEN Write(Chr(barchar))
  312.     ELSE IF histogram[binID] > barbase
  313.           THEN Write(Chr(halfbar))
  314.           ELSE Write('_');
  315.   Writeln;                             { new line       }
  316.  END;
  317.  
  318.  Write('     0');
  319.  FOR binID := 0 TO maxbit DO           { fill in bottom }
  320.   IF histogram[binID] > halfstep
  321.    THEN Write(Chr(barchar))
  322.    ELSE IF histogram[binID] > 0
  323.          THEN Write(Chr(halfbar))
  324.          ELSE Write('_');
  325.  Writeln;
  326.  
  327.  
  328.  Writeln('      0         1         2         3         ' +
  329.                '4         5         6   ');
  330.  Writeln('      0123456789012345678901234567890123456789' +
  331.                '012345678901234567890123');
  332.  
  333. END;
  334.  
  335.  
  336. {-------------------------------------------------------}
  337. { Count pels above given brightness level               }
  338.  
  339. FUNCTION CountPels(pic1 : picptr;
  340.                    level : BYTE) : REAL;
  341.  
  342. VAR
  343.  lndx      : linerng;           { line number           }
  344.  pndx      : pelrng;            { pel number            }
  345.  npels     : REAL;              { number of pels        }
  346.  
  347. BEGIN
  348.  
  349.  npels := 0.0;
  350.  
  351.  FOR lndx := 0 TO maxline DO
  352.   FOR pndx := 0 TO maxpel DO
  353.    IF pic1^.fmt.lines[lndx].pels[pndx] >= level
  354.     THEN npels := npels + 1.0;
  355.  
  356.  CountPels := npels;            { set return value      }
  357.  
  358. END;
  359.  
  360.  
  361. {-------------------------------------------------------}
  362. { Return the minimum value for pic1                     }
  363.  
  364. FUNCTION Minpel(pic1 : picptr) : BYTE;
  365.  
  366. VAR
  367.  lndx      : linerng;           { line number           }
  368.  pndx      : pelrng;            { pel number            }
  369.  minval    : BYTE;              { minimum pel value     }
  370.  
  371. BEGIN
  372.  
  373.  minval := $FF;
  374.  
  375.  FOR lndx := 0 TO maxline DO
  376.   FOR pndx := 0 TO maxpel DO
  377.    IF pic1^.fmt.lines[lndx].pels[pndx] < minval
  378.     THEN minval := pic1^.fmt.lines[lndx].pels[pndx];
  379.  
  380.  Minpel := minval;
  381.  
  382. END;
  383.